Ham Radio 2000 #2

home *** CD-ROM | disk | FTP | other *** search

/ Ham Radio 2000 #2 / Ham Radio 2000 - Volume 2.iso / HAMV2 / MISC / HCAL-27 / SUNCLOCK.BAS (.txt) < prev next >

Wrap

GW-BASIC | 1997-03-04 | 12.1 KB | 434 lines

10 'SUNCLOCK - 24 DEC 92 rev. 28 FEB 97 20 'by George Murphy VE3ERP, 77 McKenzie St., Orillia, ON L3V 6A6, CANADA 30 IF EX$=""THEN EX$="EXIT" 40 CLS:KEY OFF 50 DIM J$(7) 'dimension day name variables 60 DIM MO$(12) 'dimension month name variables 70 DIM M$(12),D(12),D$(12) 80 PI=3.14159 90 SCREEN 9 '640 x 350 pixel graphics monitor 100 ' 110 '.....load variables 120 OPEN"I",1,"\data\sunclock.fil" 130 IF EOF(1)THEN 160 140 INPUT#1,NA$,SX$,LX,LO 150 GOTO 130 160 CLOSE 170 GOSUB 1670 180 ' 190 DATA Sun,Mon,Tue,Wed,Thu,Fri,Sat 200 DATA JAN,FEB,MAR,APR,MAY,JUN,JUL,AUG,SEP,OCT,NOV,DEC 210 FOR Z=1 TO 7:READ J$(Z):NEXT Z 220 FOR Z=1 TO 12:READ MO$(Z):NEXT Z 230 ' 240 '.....start 250 SEC2=60 'locator for "Press any key to exit" 260 ASP=0.735 'aspect ratio factor 270 CX=311:CY=104 'initial coordinates of dial centre 280 LIN=8 'initial line for text 290 RD=131 'length of dial radial 300 RN=98 'length of 5 minute markers radial 310 RS=98 'length of seconds radial 320 RM=86 'length of minutes radial 330 RH=65 'length of hours radial 340 ' 350 '.....start one minute cycle 360 IF VAL(TIME$)<LAST THEN CLEAR:GOTO 10 'midnight 370 LAST=VAL(TIME$) 380 C1=12 'color 12 (red) 390 C2=7 'color 2 (green) 400 C3=1 'color 3 (blue) 410 ' 420 '.....draw clock face 430 LIN=LIN+1 'shift display one line down 440 IF LIN=16 THEN 240 'start over at top of screen 450 CY=CY+14 'shift Y coordinate one line down 460 RO=RD+16 'radius of outer ring 470 RI=RD-10 'radius of inner ring 480 RP=RO/COS(PI/6) 'radius to corner of hexagon 490 HX=TAN(PI/6)*RO '1/2 length of hexagon side 500 '.....draw hexagon 510 COLOR C2,C3 520 LINE (CX-HX,CY-RO*ASP)-(CX+HX,CY-RO*ASP) 530 LINE -(CX+RP,CY) 540 LINE -(CX+HX,CY+RO*ASP) 550 LINE -(CX-HX,CY+RO*ASP) 560 LINE -(CX-RP,CY) 570 LINE -(CX-HX,CY-RO*ASP) 580 LOCATE LIN+9,(80-LEN(SX$))/2:PRINT SX$; 590 CIRCLE(CX,CY),RI 'draw inner ring 600 ' 610 L=PI/6 '5 minute marker angle in radians 620 COLOR C2,C3 630 FOR Z=1 TO 12 'draw 5 minute markers 640 DX=SIN(L*Z)*RN/ASP 650 DY=COS(L*Z)*RN 660 CIRCLE(CX+DX,CY+DY),7 670 CIRCLE(CX+DX,CY+DY),8 680 NEXT Z 690 ' 700 HRS=VAL(LEFT$(TIME$,2)) 'hour 710 MIN=VAL(MID$(TIME$,4,2)) 'minute 720 IF HRS>12 THEN HRS=HRS-12 'convert 24 hr. clock to 12 hr. clock 730 HS=HRS*30+MIN/2+180 'hours angle in degrees 740 HS=-HS*PI/180 'hours angle in radians, clockwise rotation 750 HX=SIN(HS)*RH 'X coordinate of hour hand 760 HX=HX/ASP 'aspect ratio correction 770 HY=COS(HS)*RH 'Y coordinate of hour hand 780 ' 790 '.....start seconds counter 800 IF INKEY$<>""THEN 3630 810 T=INT(TIMER) 'current time to nearest second 820 IF T=INT(TIMER)THEN 820 'delay until next second 830 SEC=VAL(RIGHT$(TIME$,2)) 'get seconds 840 ' 850 '.....seconds 860 COLOR C3,C3 'background color 870 CIRCLE (CX+SX,CY+SY),4 'subdue seconds indicator 880 ' 890 S=SEC*6+180 'seconds angle in degrees 900 LS=-S*PI/180 'angle in radians, clockwise rotation 910 SX=SIN(LS)*RS 'X coordinate of second hand 920 SX=SX/ASP 'aspect ratio correction 930 SY=COS(LS)*RS 'Y coordinate of second hand 940 ' 950 COLOR C1,C3 960 CIRCLE (CX+SX,CY+SY),4 'print new seconds indicator 970 SEC2=SEC2-1:IF SEC2=2 THEN SEC2=59:LOCATE 25:PRINT STRING$(24,32); 980 LOCATE 25,SEC2:PRINT "Press any key to Exit "; 990 ' 1000 GOSUB 1430 'get day of week and date J$ & D$ 1010 JD$=J$+D$ 'day & date 1020 COLOR C2,1 1030 LOCATE LIN-5,33:PRINT"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE" 1040 LOCATE LIN-4,33:PRINT"OPEN OPEN" 1050 LOCATE LIN-3,33:PRINT"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD" 1060 LOCATE LIN-4,(80-LEN(JD$))/2 'centre day and date printout 1070 PRINT JD$ 'print day & date 1080 LOCATE LIN-2,29:PRINT USING "##.#";HD; 1090 PRINT " hrs. of daylight" 1100 LOCATE LIN-1,37:PRINT"to-day" 1110 LOCATE LIN,29:PRINT "(";SU$ 'sunrise 1120 LOCATE LIN,39:PRINT "--" 1130 LOCATE LIN,41:PRINT SD$;" )" 'sunset 1140 LOCATE LIN+1,39:PRINT"at" 1150 LOCATE LIN+2,(80-LEN(NA$))/2 'centre name of community 1160 PRINT NA$ 1170 LOCATE LIN+3,33:PRINT"KEYTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENCLOSE" 1180 LOCATE LIN+4,33:PRINT"OPEN OPEN" 1190 LOCATE LIN+5,33:PRINT"SCREENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENTHENLOAD" 1200 LOCATE LIN+4,36 'centre digital time printout 1210 PRINT TIME$ 'print digital time 1220 COLOR C1,C3 1230 CIRCLE (CX,CY),3 'draw dial centre 1240 PAINT(CX,CY+1) 'fill dial centre 1250 LINE (CX,CY)-(CX+HX,CY+HY) 'print hour hand 1260 ' 1270 '.....minutes 1280 COLOR C3,C3 'color blank 1290 LINE (CX,CY)-(CX+MX,CY+MY) 'blank current minute hand 1300 M=MIN*6+SEC/10+180 'minutes angle in degrees 1310 IF SEC=0 THEN M=M+6 1320 MS=-M*PI/180 'angle in radians, clockwise rotation 1330 MX=SIN(MS)*RM 'X coordinate of minute hand 1340 MX=MX/ASP 'aspect ratio correction 1350 MY=COS(MS)*RM 'Y coordinate of minute hand 1360 ' 1370 COLOR C1,C3 'color blank 1380 LINE (CX,CY)-(CX+MX,CY+MY) 'print new minute hand 1390 ' 1400 IF SEC=0 THEN CLS:GOTO 350 'end of 1 minute cycle 1410 GOTO 790 'end of 1 second cycle 1420 ' 1430 '.....day of week subroutine 1440 MO=VAL(LEFT$(DATE$,2)) 'month no. 1450 M$=MO$(MO) 'month name 1460 DA=VAL(MID$(DATE$,4,2)) 'day no. 1470 D$=RIGHT$(STR$(DA),2) 'day name 1480 IF LEN(D$)=2 THEN 1500 'insert leading space to single digit day 1490 GOTO 1480 1500 D$=" "+M$+" "+D$ 'month & day e.g. Nov. 9 1510 ' 1520 '.....calculate day of week 1530 YR=VAL(RIGHT$(DATE$,4)) 'year 1540 K=INT(0.6+1/MO) 1550 L=YR-K 1560 O=MO+12*K 1570 P=L/100 1580 Z1=INT(P/4) 1590 Z2=INT(P) 1600 Z3=INT(5*L/4) 1610 Z4=INT(13*(O+1)/5) 1620 Z=Z4+Z3-Z2+Z1+DA-1 1630 ZZ=Z-(7*INT(Z/7))+1 1640 J$=J$(ZZ) 'name of day e.g. Friday 1650 RETURN 1660 ' 1670 '.....calculate variables 1680 COLOR 7,0:CLS 1690 UL$=STRING$(80,205) 1700 ' 1710 IF LX>0 THEN LX$="<UNK! {00F8}>N"ELSE LX$="<UNK! {00F8}>S" 1720 LX$=STR$(ABS(LX))+LX$ 1730 IF LO>0 THEN LO$="<UNK! {00F8}>W"ELSE LO$="<UNK! {00F8}>E" 1740 LO$=STR$(ABS(LO))+LO$ 1750 LC$=LX$+","+LO$ 'lat.& long. of location 1760 LG=LEN(LC$) 1770 LG=LEN(LC$) 1780 H$="###.##" 1790 GOSUB 1820 1800 RETURN 1810 ' 1820 '.....Sunrise/Sunset 1830 'based on DAYLIGHT program, HAM-SOFT disk# 1247 1840 AM$=" am":PM$=" pm" 1850 '.....inputs 1860 Z1=LX 1870 IF Z1<0 THEN Z1$="S"ELSE Z1$="N" 1880 LAT=Z1*0.0174533 1890 ZONE=ZON*PI/180 1900 Z2=LO 1910 FOR Z=0 TO 12 1920 IF ABS(Z2)>=Z*15-7.5 THEN ZON=Z*SGN(Z2) 1930 NEXT Z 1940 ZONE=ZON*15*PI/180 1950 IF Z2<0 THEN Z2$="E"ELSE Z2$="W" 1960 LONG=Z2*0.0174533 1970 H=VAL(RIGHT$(DATE$,4)) 1980 I=VAL(LEFT$(DATE$,2)) 1990 J=VAL(MID$(DATE$,4,2)) 2000 I$=M$(I) 2010 '.....local standard time 2020 STC=-ZON 'solar time zone 2030 '.....day of year 2040 K=INT((I+9)/12) 2050 X=H/4 2060 Y=INT(X) 2070 Z=X-Y 2080 IF Z=0 THEN 2100 2090 K=K*2 2100 H=INT(275*I/9) 2110 H=H+J-K-30 2120 '.....sunrise phenomena 2130 I=0 2140 J=PI/2 2150 GOSUB 2500 'approximate time 2160 '.....local solar time 2170 R=-0.0145439 2180 GOSUB 2900 'coordinate conversion 2190 '.....local standard time 2200 W$=V$:IF SX$="DAYLIGHT SAVING TIME"THEN ADD=1 ELSE ADD=0 2210 GOSUB 3490 2220 RISE=V+X/60 2230 SU$=W$+AM$ 2240 DCL=Q*180/PI 2250 NOON=DCL 2260 '.....azimuth 2270 AZ=180-AZ 2280 AZ(1)=AZ 2290 ' 2300 '.....sunset phenomena 2310 I=1 2320 J=PI*1.5 2330 GOSUB 2500 'approximate time 2340 '.....local solar time 2350 R=-0.0145439 2360 GOSUB 2900 2370 '.....local standard time 2380 W$=V$:IF SX$="DAYLIGHT SAVING TIME"THEN ADD=1 ELSE ADD=0 2390 GOSUB 3490 2400 SET=V+X/60:HD=SET-RISE 'hours of daylight 2410 SD$=W$+PM$ 2420 '.....declination 2430 DCL=Q*180/PI 2440 NOON=(NOON+DCL)/2 'approx declination at noon 2450 '.....azimuth 2460 AZ=180+AZ 2470 AZ(2)=AZ 2480 RETURN 2490 ' 2500 '.....approximate time 2510 K=H+((J+LONG)/(PI*2)) 2520 '.....solar mean anomaly 2530 L=K*0.017202 2540 L=L-0.0574039 2550 '.....solar true longitude 2560 Z=SIN(L) 2570 M=L+0.0334405*Z 2580 Z=SIN(2*L) 2590 M=M+0.000349065*Z 2600 M=M+4.93289 2610 '.....quadrant determination 2620 Z=M 2630 GOSUB 3400 2640 M=Z 2650 X=M/(PI/2) 2660 Y=INT(X) 2670 Z=X-Y 2680 IF Z<>0 THEN 2700 2690 M=M+4.847E-06 2700 N=2 2710 IF M>(PI*1.5) THEN 2760 2720 N=1 2730 IF M>(PI/2) THEN 2760 2740 N=0 2750 '.....solar right ascension 2760 P=0.91746*TAN(M) 2770 P=ATN(P) 2780 '.....quadrant adjustment 2790 IF N=0 THEN 2850 2800 IF N=2 THEN 2830 2810 P=P+PI 2820 GOTO 2850 2830 P=P+PI*2 2840 '.....solar declination 2850 Q=0.39782*SIN(M) 2860 Q=Q/SQR(-Q*Q+1) 2870 Q=ATN(Q) 2880 RETURN 2890 ' 2900 '.....coordinate conversion 2910 S=R-(SIN(Q)*SIN(LAT)) 2920 S=S/(COS(Q)*COS(LAT)) 2930 '.....null phenomenon 2940 Z=ABS(S) 2950 IF Z<=1 THEN 2990 2960 V=0 2970 RETURN 2980 ' 2990 '.....adjustment 3000 S=S/SQR(-S*S+1) 3010 S=-ATN(S)+PI/2 3020 IF I=1 THEN 3040 3030 S=PI*2-S 3040 '.....local apparent time 3050 Z=0.0172028*K 3060 T=S+P-Z-1.73364 3070 '.....universal time 3080 U=T+LONG 3090 '.....wall clock time 3100 V=U-ZONE 3110 '.....decimal to sexagesimal 3120 Z=V 3130 GOSUB 3400 3140 Z=Z*3.81972 3150 '.....azimuth 3160 HR=(12-Z)*15 'hour angle in degrees 3170 HRA=HR*PI/180 'hour angle in radians 3180 X=SIN(Q)*COS(LAT)-COS(Q)*SIN(LAT)*COS(HRA) 3190 ZA=ATN(X/SQR(-X*X+1))+PI/2 'azimuth in radians 3200 AZ=ZA*180/PI 'azimuth in degrees 3210 IF AZ<0 THEN AZ=AZ+360 3220 V=INT(Z) 3230 W=(Z-V)*60 3240 X=INT(W) 3250 Y=W-X 3260 IF Y<0.5 THEN 3280 3270 X=X+1 3280 IF X<60 THEN 3310 3290 V=V+1 3300 X=0 3310 '.....conventional format 3320 Z$="00" 3330 HR$=MID$(STR$(V),2) 3340 HR$=RIGHT$(Z$+HR$,2) 3350 MI$=MID$(STR$(X),2) 3360 MI$=RIGHT$(Z$+MI$,2) 3370 V$=HR$+":"+MI$ 3380 RETURN 3390 ' 3400 '.....normalization 3410 IF Z>=0 THEN 3440 3420 Z=Z+PI*2 3430 GOTO 3400 3440 IF Z<PI*2 THEN 3470 3450 Z=Z-PI*2 3460 GOTO 3440 3470 RETURN 3480 ' 3490 '.....political time 3500 LT=VAL(LEFT$(W$,2)): RT=VAL(RIGHT$(W$,2)) 3510 LT=LT+INT(ADD): RT=(RT+(ADD-INT(ADD))*60) 3520 IF RT>=60 THEN RT=60-RT:LT=LT+1 3530 IF LT=24 THEN LT=12:GOTO 3560 3540 IF LT>24 THEN LT=LT-12:PM$=AM$ 3550 IF LT>12 THEN LT=LT-12 3560 LT$=STR$(LT): RT$=STR$(RT) 3570 LT$=RIGHT$(LT$,LEN(LT$)-1): RT$=RIGHT$(RT$,LEN(RT$)-1) 3580 IF LEN(LT$)<2 THEN LT$=" "+LT$:GOTO 3580 3590 IF LEN(RT$)<2 THEN RT$="0"+RT$:GOTO 3590 3600 W$=LT$+":"+RT$ 3610 RETURN 3620 ' 3630 '.....exit/change parameters 3640 SCREEN 0:CLS:LOCATE 11,16:COLOR 14 3650 PRINT "Press any key to change variable paramaters....." 3660 LOCATE 13,16 3670 PRINT "otherwise this note will vanish in 4 seconds and" 3680 LOCATE 15,16 3690 PRINT "the program will end............................" 3700 COLOR 7,0 3710 T1=TIMER 3720 IF INKEY$<>""THEN 3770 3730 T2=TIMER 3740 IF INT(T2-T1)=4 THEN CLS:RUN EX$ 3750 GOTO 3720 3760 ' 3770 '.....change parameters 3780 CLS 3790 PRINT "The notations 'STANDARD TIME' and 'DAYLIGHT SAVING TIME' refer "; 3800 PRINT "only to the" 3810 PRINT "times of sunup and sundown shown on the clock dial." 3820 PRINT 3830 PRINT "You can change settings at any time." 3840 COLOR 0,7:PRINT "'";SX$;"'";" is the current setting." 3850 COLOR 7,0 3860 PRINT "Do you want to switch the setting now? (y/n)" 3870 Z$=INKEY$ 3880 IF Z$="n"OR Z$="N"THEN 3930 3890 IF Z$="y"OR Z$="Y"THEN 3910 3900 GOTO 3870 3910 IF SX$=""OR SX$="DAYLIGHT SAVING TIME"THEN SX$="STANDARD TIME":GOTO 3930 3920 IF SX$="STANDARD TIME"THEN SX$="DAYLIGHT SAVING TIME":GOTO 3930 3930 COLOR 0,7:PRINT "'";SX$;"'";" is the new setting." 3940 COLOR 7,0 3950 PRINT 3960 PRINT "The time shown by the clock hands and in the digital display is "; 3970 PRINT "the time you"; 3980 PRINT "have set on your computer's internal clock." 3990 PRINT STRING$(80,205); 4000 PRINT "Current location is "; 4010 COLOR 0,7:PRINT " ";NA$;" ":COLOR 7,0 4020 PRINT ".....Press <ENTER> if OK or....." 4030 LINE INPUT "ENTER name of some other location? ";Z$ 4040 IF Z$=""THEN 4060 4050 NA$=Z$:LN=CSRLIN-3:VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN:GOTO 4000 4060 PRINT 4070 IF SGN(LX)=1 THEN L$="N."ELSE L$="S." 4080 PRINT "Current latitude used in calculations is "; 4090 COLOR 0,7:PRINT ABS(LX);"<UNK! {00F8}>";L$;" ":COLOR 7,0 4100 PRINT ".....Press <ENTER> if OK or....." 4110 PRINT"ENTER latitude in decimal degrees (minus if South) of ";NA$;:INPUT Z$ 4120 IF Z$=""THEN 4150 4130 LX=VAL(Z$) 4140 LN=CSRLIN-3:VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN:GOTO 4070 4150 PRINT 4160 IF SGN(LO)=1 THEN L$="W."ELSE L$="E." 4170 PRINT "Current longitude used in calculations is "; 4180 COLOR 0,7:PRINT ABS(LO);"<UNK! {00F8}>";L$;" ":COLOR 7,0 4190 PRINT ".....Press <ENTER> if OK or....." 4200 PRINT"ENTER longitude in decimal degrees (minus if West) of ";NA$;:INPUT Z$ 4210 IF Z$=""THEN 4250 4220 LO=-VAL(Z$) 4230 LN=CSRLIN-3:VIEW PRINT LN TO 24:CLS:VIEW PRINT:LOCATE LN:GOTO 4160 4240 ' 4250 '.....save data 4260 OPEN"O",1,"\data\sunclock.fil" 4270 WRITE#1,NA$ 4280 WRITE#1,SX$ 4290 PRINT#1,LX 4300 PRINT#1,LO 4310 CLOSE 4320 CLEAR:GOTO 10 4330 END